Map

Column

Lake Map

Lake Profile Heatmap

Column

Annual Heatmap

---
title: "Kerr Heatmaps Flexdashboard"
output: 
  flexdashboard::flex_dashboard:
    orientation: columns
    vertical_layout: fill
    source_code: embed
---

```{r setup, include=FALSE}

# Built in R 3.6.1

library(tidyverse)
library(flexdashboard)
library(crosstalk)
library(plotly)
library(DT)
library(htmltools)
library(lubridate)
library(sf)
library(mapview)
library(inlmisc)

# custom functions

interpolateData <- function(data = data,
                            dateCol = NA,
                            dateTimeFormat = '%M-%D-%Y',
                            depthCol= NA,
                            parameterCol = NA,
                            depth_units = NA){
  data <- as.data.frame(data) # only work with dataframes, tibbles etc. are difficult for interpolation method
  
  # manipulate dataset to standardized format
  data1 <- mutate(data, Date = as.Date(get(dateCol), format = dateTimeFormat),
           Depth = get(depthCol),
           parameter = get(parameterCol) ) %>%
    dplyr::select(Date, Depth, parameter) %>% # just the columns we want
    drop_na() # get rid of any missing data bc everything at this point is critical for interpolation
  
  # interpolate between sample events
  int = akima::interp(data1[, 'Date'], data1[, 'Depth'], data1[, 'parameter'], duplicate = "strip", linear = TRUE)

    results <- list(data1,int)
  return(results)
}  
  

contour.heatmap <- function(int = int,
                            reverseColorPalette = FALSE,
                            title = NA,
                            criteria = NA,
                            depth_units = "m"){
  filled.contour(int[[2]], color.palette = function(n) topo.colors(n, rev= reverseColorPalette), 
               xlim = c(min(int[[1]][, 'Date']) - 1, max(int[[1]][, 'Date']) + 1), 
               ylim = rev(range(int[[1]][, 'Depth'])), 
               ylab = paste0("Depth (", depth_units, ")"), 
               main = title, 
               plot.axes = {
                 contour(int[[2]], levels = criteria, lwd = 2, col = "red", 
                         drawlabels = TRUE, axes = FALSE, frame.plot = FALSE, 
                         add = TRUE, labcex = 2)
                 axis(1, at = unique(int[[1]][, 'Date']), labels = unique(int[[1]][,'Date']), par(las = 2))
                 axis(2)}
               )
}

int_heatmap <- function(rawData, 
                        stationFilter, 
                        yearFilter,
                        stationCol,
                        dateCol,
                        depthCol,
                        parameterCol,
                        criteriaCol,
                        dateFormat,
                        reverseColorPalette){
  # use non standard evaluation
  stationCol1 <- suppressWarnings(enquo(stationCol))
  parameterCol1 <- suppressWarnings(enquo(parameterCol))
  dateCol1 <- suppressWarnings(enquo(dateCol))
  depthCol1 <- suppressWarnings(enquo(depthCol))
  criteriaCol1 <- suppressWarnings(enquo(criteriaCol))
  
  # establish criteria
  criteria <- as.numeric(unique(select(rawData, !!criteriaCol1)))
 
  # First check to make sure station and station column exist in dataset
  if(suppressWarnings(!(as.character(stationCol1)[2] %in% names(rawData))) | 
     nrow(filter(rawData, !!stationCol1 %in% stationFilter)) == 0){
    stop('Make sure the station is in the station column and the station column is correctly called')
  }
  
  
  
  # filter dataset by desired station and no NA's in parameter
  dat <- filter(rawData, !!stationCol1 %in% stationFilter & !is.na(!!parameterCol1)) %>%
    # make column names what we need for calculation
    dplyr::select(!!dateCol1, !!depthCol1,!!parameterCol1) %>% # first order them to make it all work
    rename(Date = !!names(.[1]),
           Depth = !!names(.[2]),
           parameter = !!names(.[3])) %>%
    mutate(Year = year(!!dateCol1))  # make sure there is a year column
  
  # Make sure year is an option
  if(!(yearFilter %in% unique(dat$Year))){
    stop('Make sure you entered a valid year from dataset')
  }
  dat <- filter(dat, Year %in% yearFilter)
  
  # interpolate contours for parameter
  int_year <- interpolateData(data = dat,
                              dateCol = 'Date',
                              dateTimeFormat = dateFormat,
                              depthCol = "Depth",
                              parameterCol = 'parameter',
                              depth_units = "m")

  suppressWarnings(contour.heatmap(int_year, reverseColorPalette = reverseColorPalette, 
                  criteria = criteria))
}


```


```{r data in,include=FALSE}
kerr <- read_csv('data/Kerr2010-Sept2019.csv') %>%
  mutate(Date = as.Date(`Date Time`, format = "%m/%d/%Y %l:%M %p"), # fix wonky date format
         Year = year(Date)) # and make a year variable for easy filtering

WQSvalues <- tibble(CLASS = c('I',"II","II","III","IV","V","VI","VII"),
                    `Description Of Waters` = c('Open Ocean', 'Tidal Waters in the Chowan Basin and the Atlantic Ocean Basin',
                                                'Tidal Waters in the Chesapeake Bay and its tidal tributaries',
                                                'Nontidal Waters (Coastal and Piedmont Zone)','Mountainous Zone Waters',
                                                'Stockable Trout Waters','Natural Trout Waters','Swamp Waters'),
                    `Dissolved Oxygen Min (mg/L)` = c(5,4,NA,4,4,5,6,NA),
                    `Dissolved Oxygen Daily Avg (mg/L)` = c(NA,5,NA,5,5,6,7,NA),
                    `pH Min` = c(6,6,6.0,6.0,6.0,6.0,6.0,3.7),
                    `pH Max` = c(9.0,9.0,9.0,9.0,9.0,9.0,9.0,8.0),
                    `Max Temperature (C)` = c(NA, NA, NA, 32, 31, 21, 20, NA))

kerr <- left_join(kerr, WQSvalues, by = 'CLASS')

# first count depth per station
kerr_depths <- dplyr::select(kerr, FDT_STA_ID, `Date Time`, Depth) %>%
  group_by(FDT_STA_ID) %>%
  summarize(maxDepth = max(Depth)) %>%
  mutate(Profile = as.factor(ifelse(maxDepth > 0.3, 'Profile Available', 'Surface')))

# spatial dataset
kerr_sf <- distinct(kerr, FDT_STA_ID, .keep_all = T) %>%
  left_join(kerr_depths, by = 'FDT_STA_ID') %>% # join depth info
  dplyr::select(-c(Depth:`Do Optical`)) %>% # get rid of data
  st_as_sf(coords = c('Longitude', 'Latitude'),
           crs = 4326)


# Crosstalk shared datasets for 'interactive' feel
shared_raw_data <- SharedData$new(kerr, ~FDT_STA_ID, group = 'Choose Station')
shared_sites_sf <- SharedData$new(kerr_sf, ~FDT_STA_ID, group = 'Choose Station' )

```

Sidebar {.sidebar}
=====================================

### Dataset Filters

Choose a StationID and year to filter heatmaps.

```{r filtering}
bscols(
  list(
    filter_select("StationID", "Station ID", shared_raw_data, ~FDT_STA_ID)
  )
)

```



Need help with the dashboard?

send email

Map {data-icon="fa-globe"} ===================================== Column {data-width=200} ------------------------------------- ### Lake Map ```{r site map, echo=FALSE} mapview(kerr_sf, label=kerr_sf$FDT_STA_ID, zcol = 'Profile', layer.name = 'DEQ Kerr Stations') # mapview doesnt work with crosstalk, yet ``` ```{r webmap, eval=FALSE} CreateWebMap(maps = c("Topo","Imagery","Hydrography"), collapsed = TRUE) %>% setView(-78, 37.5, zoom=6) %>% addCircleMarkers(data=shared_sites_sf, color = ~Profile, radius = 5, #color='yellow', fillColor='blue', radius = 5, fillOpacity = 0.5,opacity=1,weight = 2,stroke=T,group="sites", label = ~FDT_STA_ID)%>% inlmisc::AddHomeButton(raster::extent(-83.89, -74.80, 36.54, 39.98), position = "topleft") %>% inlmisc::AddSearchButton(group = "sites", zoom = 15,propertyName = "label", textPlaceholder = "Search stations") %>% addLayersControl(baseGroups=c("Topo","Imagery","Hydrography"), overlayGroups = c('sites'), options=layersControlOptions(collapsed=T), position='topleft') ``` Lake Profile Heatmap {data-orientation=rows data-icon="fa-calculator"} ===================================== Column {data-width=200} ------------------------------------- ### Annual Heatmap ```{r heatmap} int_heatmap(kerr, stationFilter = '4AROA022.52', yearFilter = 2012, stationCol = FDT_STA_ID, dateCol = Date, depthCol = Depth, parameterCol = `Temp Celsius`, criteriaCol = `Max Temperature (C)`, dateFormat= '%Y-%m-%d', reverseColorPalette = TRUE) ```